VERSION 5.00
Begin VB.Form Form1 
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   1  'Fixed Single
   Caption         =   "Form1"
   ClientHeight    =   3375
   ClientLeft      =   2865
   ClientTop       =   2100
   ClientWidth     =   5295
   ClipControls    =   0   'False
   ControlBox      =   0   'False
   Icon            =   "StdDataLogger.frx":0000
   LinkMode        =   1  'Source
   LinkTopic       =   "Data"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   3375
   ScaleWidth      =   5295
   Begin VB.TextBox Text1 
      Appearance      =   0  'Flat
      BackColor       =   &H80000018&
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   405
      Left            =   120
      MultiLine       =   -1  'True
      ScrollBars      =   3  'Both
      TabIndex        =   15
      TabStop         =   0   'False
      Top             =   2040
      Visible         =   0   'False
      Width           =   2175
   End
   Begin VB.CommandButton pB 
      Caption         =   "Quit..."
      Height          =   375
      Index           =   5
      Left            =   0
      TabIndex        =   3
      TabStop         =   0   'False
      Top             =   360
      Width           =   1095
   End
   Begin VB.CommandButton pB 
      Caption         =   "Reload ini"
      Height          =   375
      Index           =   9
      Left            =   3240
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   0
      Width           =   1095
   End
   Begin VB.CommandButton pB 
      Caption         =   "Edit ini"
      Height          =   375
      Index           =   8
      Left            =   2160
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   0
      Width           =   1095
   End
   Begin VB.CommandButton pB 
      Cancel          =   -1  'True
      Caption         =   "Hide..."
      Default         =   -1  'True
      Height          =   375
      Index           =   0
      Left            =   4320
      TabIndex        =   5
      TabStop         =   0   'False
      Top             =   0
      Width           =   975
   End
   Begin VB.CommandButton pB 
      Caption         =   "Start Log"
      Height          =   375
      Index           =   4
      Left            =   1080
      TabIndex        =   6
      TabStop         =   0   'False
      Top             =   0
      Width           =   1095
   End
   Begin VB.CommandButton pB 
      Caption         =   "About..."
      Height          =   375
      Index           =   3
      Left            =   0
      TabIndex        =   4
      TabStop         =   0   'False
      Top             =   0
      Width           =   1095
   End
   Begin VB.VScrollBar VScroll1 
      Height          =   1575
      Left            =   4920
      TabIndex        =   12
      TabStop         =   0   'False
      Top             =   1680
      Width           =   255
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Left            =   4320
      Top             =   2040
   End
   Begin VB.CheckBox Check1 
      BackColor       =   &H00FFFFFF&
      Caption         =   "Ask for file name when stopping log."
      Height          =   375
      Index           =   0
      Left            =   1320
      TabIndex        =   9
      TabStop         =   0   'False
      Top             =   360
      Width           =   2895
   End
   Begin VB.Label LnkVal 
      Alignment       =   1  'Right Justify
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "LnkVal"
      ForeColor       =   &H80000008&
      Height          =   255
      Index           =   0
      Left            =   240
      TabIndex        =   10
      ToolTipText     =   "Displays the current value"
      Top             =   1440
      Width           =   1095
   End
   Begin VB.Label Label3 
      Appearance      =   0  'Flat
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   1  'Fixed Single
      ForeColor       =   &H80000008&
      Height          =   135
      Left            =   120
      TabIndex        =   14
      Top             =   840
      Width           =   135
   End
   Begin VB.Line Line1 
      BorderColor     =   &H00C0C0C0&
      Index           =   0
      X1              =   120
      X2              =   4800
      Y1              =   1680
      Y2              =   1680
   End
   Begin VB.Label LnkIdx 
      Alignment       =   1  'Right Justify
      BackStyle       =   0  'Transparent
      Caption         =   "LnkIdx"
      Height          =   255
      Index           =   0
      Left            =   0
      TabIndex        =   13
      Top             =   1440
      Width           =   255
   End
   Begin VB.Label LnkDesc 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      Caption         =   "LnkDesc"
      ForeColor       =   &H80000008&
      Height          =   255
      Index           =   0
      Left            =   1560
      TabIndex        =   11
      Top             =   1440
      Width           =   3255
   End
   Begin VB.Label Label2 
      BackColor       =   &H00FFFFFF&
      BackStyle       =   0  'Transparent
      Caption         =   "Logging for: hh:mm:ss"
      Height          =   255
      Left            =   3480
      TabIndex        =   8
      Top             =   840
      Width           =   1575
   End
   Begin VB.Label link 
      Alignment       =   2  'Center
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      Caption         =   "link"
      ForeColor       =   &H80000008&
      Height          =   255
      Index           =   0
      Left            =   3720
      LinkItem        =   "s:23"
      LinkTimeout     =   5
      LinkTopic       =   "rslinx|tkagt17"
      TabIndex        =   7
      Top             =   2160
      Visible         =   0   'False
      Width           =   495
   End
   Begin VB.Label Label1 
      BackColor       =   &H00FFFFFF&
      BackStyle       =   0  'Transparent
      Caption         =   "Label1"
      Height          =   255
      Left            =   1320
      TabIndex        =   0
      Top             =   840
      Width           =   2055
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'PLC Data Logger
'Reads a ini file with same name as excutable
'The init is a tab separated file describing the DDE links to connect to for logging and scaling to apply
'If the firstline start +loginterval[TAB]100 then log every 100 mS - hope the DDE server is set to collect at that rate.
'Generates a Daily time stamped file - runs for months on end.
'Version 1
'
'This and all this projects sub files are released into the Public Domain - DJR 2008.


Option Explicit
DefInt A-Z
Private GD As globalIniType 'global data
Private LNK() As ddeLinkType 'database
Private Flist As FunnyLabelListCtrl
Dim nl As String 'new line chr
Dim tb As String 'tab chr

Sub a_about()

Dim txt As String
Dim NewLin As String
NewLin = Chr(13) & Chr(10)
  
txt = "StdDataLogger." & NewLin & "Connects to DDE Servers." & NewLin & "Logs to a time stamped tab seperated file." & NewLin & _
  "Reads a .ini file for setup." & NewLin & NewLin & "Some internal data:" & NewLin

  With GD
    txt = txt & "ini = " & .ini & NewLin
    txt = txt & "lastlink = " & .lastlink & NewLin
    txt = txt & "logfile = " & .logfile & NewLin
    txt = txt & "lthisday = " & .thisday & NewLin
    txt = txt & "loginterval = " & .loginterval & " mS (limits min=10 max=120,000)" & NewLin
    txt = txt & "recwritten = " & .recwritten & NewLin
    txt = txt & "logfileptr = " & .logfileptr & NewLin
    txt = txt & "logfileopen = " & .bLogFileOpen & NewLin
  End With
  
  Text1 = txt
  Text1.Left = 0
  Text1.Top = 0
  Text1.Width = Me.Width - 80
  Text1.Height = Me.Height - 360
  Text1.Visible = True

End Sub

Sub a_ddelink_build()
Dim idx As Integer
Dim nul As Integer
For idx = 1 To GD.lastlink
    Load link(idx)
    link(idx).LinkTopic = LNK(idx).app & "|" & LNK(idx).topic
    link(idx).LinkItem = LNK(idx).item
    link(idx).LinkTimeout = 2
    link(idx) = "~ "
Next
    link(0) = GD.lastlink
End Sub

Sub a_ddelink_destroy()
  Dim idx
  For idx = 1 To Val(link(0))
    link(idx).LinkMode = 0
    Unload link(idx)
  Next
End Sub

Sub a_ddelink_start()
  On Error Resume Next
  Dim idx, nul
  For idx = 1 To Val(link(0))
    link(idx).LinkMode = vbLinkAutomatic
    nul = DoEvents
  Next
End Sub

Sub a_ddelink_stop()
  On Error Resume Next
  Dim idx
  For idx = 1 To Val(link(0))
      link(idx).LinkMode = 0
    Next
End Sub

Sub a_list_build()

Flist.BigListLen = GD.lastlink
Flist.ListLen = Flist.BigListLen
If Flist.ListLen > 5 Then Flist.ListLen = 5
Flist.ListIndex = 1

'Uses
'LnkIdx()
'LnkVal()
'LnkDesc()

LnkIdx(0) = ""
LnkVal(0) = ""
LnkDesc(0) = ""


Dim idx As Integer

For idx = 1 To Flist.ListLen
  Load Line1(idx)
  Line1(idx).Y1 = ((LnkIdx(0).Height + 50) * idx) + Line1(0).Y1
  Line1(idx).Y2 = Line1(idx).Y1
  
  Load LnkIdx(idx)
  LnkIdx(idx).Top = ((LnkIdx(0).Height + 50) * idx) + LnkIdx(0).Top
  LnkIdx(idx) = idx
  
  Load LnkVal(idx)
  LnkVal(idx).Top = ((LnkVal(0).Height + 50) * idx) + LnkVal(0).Top
  
  Load LnkDesc(idx)
  LnkDesc(idx).Top = ((LnkDesc(0).Height + 50) * idx) + LnkDesc(0).Top
  
  LnkIdx(idx).Visible = True
  LnkVal(idx).Visible = True
  LnkDesc(idx).Visible = True
  Line1(idx).Visible = True
  
Next

LnkIdx(0) = ""
LnkVal(0) = "Value"
LnkDesc(0) = "Description"

If Flist.BigListLen > 0 Then
  VScroll1.Min = 0
  VScroll1.Max = Flist.BigListLen - Flist.ListLen
  VScroll1.LargeChange = Flist.ListLen - 1
  VScroll1_Change
End If

End Sub

Sub a_list_destroy()
Dim idx As Integer
  For idx = 1 To Flist.ListLen
    Unload LnkIdx(idx)
    Unload LnkVal(idx)
    Unload LnkDesc(idx)
    Unload Line1(idx)
  Next
  Flist.ListLen = 0
  
  VScroll1 = 0
  VScroll1.Min = 0
  VScroll1.Max = 0
  VScroll1.LargeChange = 1

End Sub

Private Sub Text1_Click()
  Text1.Visible = False
End Sub

Private Sub VScroll1_Change()
  Flist.ListIndex = VScroll1.Value + 1
  Dim idx As Integer
  Dim idxOS As Integer
  For idx = 1 To Flist.ListLen
      idxOS = idx + Flist.ListIndex - 1
      LnkIdx(idx) = idxOS
      LnkVal(idx) = Format(Val(link(idxOS)) * LNK(idxOS).scl, "0.00")
      LnkVal(idx).ToolTipText = LNK(idxOS).app & " - " & LNK(idxOS).topic & " - " & LNK(idxOS).item & " Scl:" & LNK(idxOS).scl
      LnkDesc(idx) = LNK(idxOS).desc
  Next
End Sub

Private Sub a_ini_load()
  
  Dim pFile As Integer
  Dim lastlink As Integer
  Dim ddeApp As String
  Dim ddeTopic As String
  ReDim LNK(1 To 1)
  pFile = FreeFile
  
  On Error GoTo LoadIni_Err1
  Open GD.ini For Input As pFile
  
  On Error GoTo LoadIni_Err2
  lastlink = 0
  
  Do Until EOF(pFile)
    ReDim srec(0 To 0) As String
    Line Input #pFile, srec(0)
    a_Phrase srec(), Chr(9)
    
    'Extract Options.
    If Left(srec(1), 1) = "+" Then
      If LCase(srec(1)) = LCase("+loginterval") Then GD.loginterval = Val(srec(2))
    End If
    
    'Extract Records
    If Val(srec(0)) = 5 Then
      lastlink = lastlink + 1
      ReDim Preserve LNK(1 To lastlink)
      LNK(lastlink).app = srec(1)
      LNK(lastlink).topic = srec(2)
      LNK(lastlink).item = srec(3)
      LNK(lastlink).desc = srec(4)
      LNK(lastlink).scl = srec(5)
    End If
  Loop
  
  Close pFile
  
  GD.lastlink = lastlink
  
  On Error GoTo 0
  Exit Sub
  
  'Errors-----------------------------------------------
LoadIni_Err1:   'File Not Found
  MsgBox "The ini file was not found - it needs to have the same name as the .exe and be in the same folder."
  On Error GoTo 0
  Exit Sub
  
LoadIni_Err2:   'Error While Loading File
  MsgBox "The ini file was faults in some way and caused some sort of file reading error - maybe it does not use tabs as seperators."
  On Error GoTo 0
  Exit Sub
  
End Sub
Sub a_log_close()
  
  Static Suffix As String
  Dim MsgTxt As String
  Dim bWasFIleOpen As Boolean
  bWasFIleOpen = GD.bLogFileOpen
  
  On Error Resume Next
  If GD.bLogFileOpen Then Close GD.logfileptr
  GD.bLogFileOpen = False
  
  If Check1(0).Value = 1 And bWasFIleOpen Then
    
    MsgTxt = "Please enter a file suffix - Normal file naming rules apply." & Chr(10) & _
      "The file name: " & app.EXEName & " yyyymmdd hhmmss SUFFIX.tab" & Chr(10) & _
      "Press Cancel for no suffix - the file remains with its time stamped name."
      
    Suffix = Trim(InputBox(MsgTxt, , Suffix))
    If Len(Trim(Suffix)) > 0 Then Name GD.logfile As Left(GD.logfile, Len(GD.logfile) - 4) & " " & Suffix & ".tab"
  End If
End Sub

Sub a_log_now()
'write a scaled record to the log file - if its not open open it.

Dim idx
Dim SysTim As SYSTEMTIME
Const msScl = 8640000
If Not GD.bLogFileOpen Then a_log_open
On Error GoTo log_write_err

GetSystemTime SysTim
Print #GD.logfileptr, _
  Date; tb; _
  Time; tb; _
  SysTim.wMilliseconds; tb;


For idx = 1 To GD.lastlink
  Print #GD.logfileptr, Val(link(idx)) * LNK(idx).scl;
  If idx < GD.lastlink Then Print #GD.logfileptr, tb;
Next

Print #GD.logfileptr, ""
GD.recwritten = GD.recwritten + 1

Exit Sub

log_write_err:
  MsgBox "Failed to write to logging file. This is the VB error reported:" & Err.Description
  GD.logging = False
  On Error GoTo 0
  Exit Sub

End Sub
Sub a_log_open()
Static LastFileName As String
'If the file is open (it should not be) close it.
If GD.bLogFileOpen = True Then a_log_close

Dim lastlink
Dim idx
lastlink = GD.lastlink
GD.logfileptr = FreeFile
On Error GoTo open_err

GD.logfile = app.Path & "\" & app.EXEName & " " & Format(Now(), "YYYYMMDD HHMMSS") & ".tab"
Open GD.logfile For Append Access Write Lock Write As GD.logfileptr
Print #GD.logfileptr, "Date"; tb; "Time"; tb; "mSec"; tb;

For idx = 1 To lastlink
  Print #GD.logfileptr, LNK(idx).desc;
  If idx < lastlink Then Print #GD.logfileptr, tb;
Next

Print #GD.logfileptr, ""
GD.bLogFileOpen = True
GD.recwritten = 0
GD.vStartTime = Now()
On Error GoTo 0
Exit Sub

open_err:
  MsgBox "Failed to open the logging file. This is the VB error reported: " & Err.Description
  On Error GoTo 0
  Exit Sub
End Sub
Sub a_pbEnable(code As Integer)

'pB-0 = Hide
'pB-1 = ...
'pB-2 = ...
'pB-3 = About
'pB-4 = Start/Stop Logger
'pB-5 = Quit
'pB-6 = ...
'pB-7 = ...
'pB-8 = Edit ini
'pB-9 = ReLoad ini

pB(0).Enabled = True 'Hide
pB(3).Enabled = True 'About
pB(4).Enabled = True 'Start/Stop
pB(5).Enabled = True 'Quit
pB(8).Enabled = True 'Edit Ini
pB(9).Enabled = True 'ReLoadIni

'0 = No Ini Loaded
'1 = Ini Loaded - Not Logging
'2 = Logging
'3 = Logging Paused
'4 = Load Form

Select Case code
Case 0 '0 = No Ini Loaded
pB(4).Enabled = False 'Start/Stop
 
Case 1 '1 = Ini Loaded - Not Logging

Case 2 'Logging
pB(5).Enabled = False 'Quit
pB(9).Enabled = False 'ReLoadIni

Case 3 'Logging Paused
  pB(1).Enabled = False
  pB(2).Enabled = False
  pB(6).Enabled = False
  pB(7).Enabled = False
  pB(9).Enabled = False

End Select

End Sub

Private Sub Form_Load()
  If app.PrevInstance Then End
  'initalize global constants
  nl = Chr(10)   'new line
  tb = Chr(9) 'tab
  Me.Caption = app.EXEName & " (" & app.Major & "." & app.Minor & "." & app.Revision & ")"
  Me.Show
  a_ReStart
End Sub

Sub a_Phrase(sArray() As String, sSeperator As String)
  
  'On Error GoTo PhraseErr
  'General Purpose String Seperator
  'The string to be seperated is passed in sArray()
  
  Dim iStart, iEnd, pRec, iSepLen As Integer
  iStart = 1
  iSepLen = Len(sSeperator)
  
  Do  'Loop till all records recovered
    iEnd = InStr(iStart, sArray(0), sSeperator) 'Find a seperator
    If iEnd = 0 Then
      iEnd = Len(Mid(sArray(0), iStart)) + iStart
      If iEnd = iStart Then Exit Do 'Humm No seperator found
    End If
    pRec = pRec + 1
    ReDim Preserve sArray(0 To pRec)  'Increase array by 1 record
    sArray(pRec) = Trim(Mid(sArray(0), iStart, iEnd - iStart))  'Insert trimmed seperated text into array
    iStart = iEnd + iSepLen  'Point to the new search start point
  Loop

'Tidyup
  sArray(0) = Trim(pRec)
  Exit Sub

'ERROR HANDLER
PhraseErr:
  sArray(0) = Trim(-1)
  Exit Sub
End Sub

Private Sub Form_Unload(Cancel As Integer)
  If GD.bLogFileOpen Then a_log_close
  a_ddelink_stop
  a_ddelink_destroy
End Sub

Private Sub pB_Click(Index As Integer)
  Dim nul As Long
  Select Case Index
    
    Case 0
      Me.WindowState = 1
    Case 1 'Paste ini
    Case 2 'Copy ini
    
    Case 3 ' About
      a_about
    
    Case 4 'Start/Stop Logging
      If Not GD.logging Then
        a_pbEnable 2
        pB(4).Caption = "Stop Log"
        GD.logtimer = 0
        GD.logging = True
      Else
        GD.logging = False
        a_log_close
        a_pbEnable 1
        pB(4).Caption = "Start Log"
      End If
    
    Case 5 'Quit
      Unload Me
    
    Case 6 '...
    Case 7 '...
    
    Case 8 'Edit Ini
      nul = Shell("NotePad.exe " & GD.ini, 1)
    
    Case 9 'Reload ini
      a_ReStart
        
  End Select

End Sub

Private Sub Timer1_Timer()

If Label3.BackColor = &HFF00& Then
  Label3.BackColor = 16777215
Else
  Label3.BackColor = &HFF00&
End If

Label1 = "Records to disk: " & GD.recwritten
If GD.logging Then Label2 = "Logging for: " & Format(GD.vStartTime - Now(), "hh:mm:ss")

'refresh link data to the list
Dim idx As Integer
For idx = 1 To Flist.ListLen
  LnkVal(idx) = Format(Val(link(idx + Flist.ListIndex - 1)) * LNK(idx + Flist.ListIndex - 1).scl, "0.00")
Next
  
'logging

If GD.logging And GD.loginterval <= 1000 Then a_log_now

If GD.logging And GD.loginterval > 1000 Then
  GD.logtimer = GD.logtimer - 1
  If GD.logtimer <= 0 Then
    a_log_now
    GD.logtimer = GD.loginterval / 1000
  End If
End If

'rollover to next file
If GD.logging Then
  If GD.thisday <> Format(Now(), "YYYYMMDD") Then
  a_log_close
  a_log_now
  End If
End If
GD.thisday = Format(Now(), "YYYYMMDD")

End Sub

Sub a_ReStart()
  Timer1.Enabled = False
  
  a_ddelink_stop
  a_ddelink_destroy
  a_list_destroy
  
  Label1 = ""
  Label2 = ""
  link(0) = "~ "
  a_pbEnable 0
  
 'Reset inital ini values
  With GD
    .ini = CurDir & "\" & app.EXEName & ".ini"
    .lastlink = 0
    .logfile = app.Path & "\" & app.EXEName & " yyyy mm dd.tab"
    .thisday = Format(Now(), "YYYYMMDD")
    .recwritten = 0
    .loginterval = 1000
    .logtimer = 0
    .logging = False
    .logfileptr = 0
    .bLogFileOpen = False
 End With
  
  a_ini_load
  a_ddelink_build
  a_list_build
  a_ddelink_start
  
  If GD.loginterval < 10 Then GD.loginterval = 10
  If GD.loginterval > 120000 Then GD.loginterval = 120000
  
  If GD.loginterval <= 1000 Then Timer1.Interval = GD.loginterval
  If GD.loginterval > 1000 Then Timer1.Interval = 1000
  Timer1.Enabled = True
  
  a_pbEnable 1
  
End Sub
